perm filename LOOP.OLD[XX,LCS]1 blob
sn#192540 filedate 1975-12-18 generic text, type T, neo UTF8
TITLE LOOP ; SUBROUTINE LOOP(I,J,L,M,N)
ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
ENTRY SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,FSCAN
EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,HOMNEW
DEFINE FIXX(N)
< JUMPGE N,.+5
MOVNS N
FIX N,233000
MOVNS N
CAIA
FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
; DIMENSION N(1)
MM←1 ↔ NN←2 ↔ J←3
LOOP: 0 ; DO 1 NN=I+L,J+L,K
MOVE 1,@4(16)
SUB 1,@3(16) ; MM IS IN 1
MOVE 2,@(16)
ADD 2,@3(16) ;I+L -- NN, 1ST TIME
MOVE 3,@1(16)
ADD 3,@3(16) ;J+L
MOVE 4,@2(16) ;K
HRRZI 5,@5(16) ; ADR. OF N
ADDI 2,-1(5) ; N(NN)
ADDI 3,-1(5)
JUMPL 4,LP3 ; JUMP IF NEG. INCR.
HRRM 1,.+1 ; ADD IN MM
LP1: MOVE 6,(2)
MOVEM 6,(2) ;N(NN)=N(NN+MM)
CAIGE 2,(3)
AOJA 2,LP1
JRA 16,6(16)
LP3: HRRM 1,.+1
LP2: MOVE 6,(2) ;NEG. INCR.
MOVEM 6,(2)
CAILE 2,(3)
SOJA 2,LP2
JRA 16,6(16) ; END
PLACE: 0 ; FUNCTION PLACE(X)
; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
; EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
MOVN 2,@(16) ; PLACE=R11-ABS(RD-X)
FADR 2,XRN+=3999 ;END
MOVMS 2
MOVE 0,.COMM.+=12 ;R11
FSBR 0,2
JRA 16,1(16)
FINDIT: 0 ; FUNCTION FINDIT(N)
SETZ ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
HRRZ 1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;; HRRZI 2,PTR ; FINDIT=0
;; ADDI 1,(2) ; L=PWDS(N)
;; MOVE 2,-1(1) ; IF(RN(L+1).NE.1)GO TO 377
;; FIXX(2) ; IF(RN(L+2).EQ.R2)RETURN
;; HRRZI 3,XRN ;377 FINDIT=-1
;; ADDI 3,(2) ; END
;; MOVE 5,(3) ; RN(L+1)
MOVE 2,PTR-1(1) ;THESE 3 REPLACE ABOVE
;X FIXX(2)
MOVE 5,XRN(2)
CAME 5,[1.0]
JRST FNEG
MOVEM 2,PTR+=251 ; SENDS BACK A NUM IN L
;; MOVE 5,1(3) ;RN(L+2)
MOVE 5,XRN+1(2)
CAME 5,.COMM.
FNEG: SETO
JRA 16,1(16)
DPYNEW: 0 ; SUBROUTINE DPYNEW
JSA 16,ACCPOG ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
JUMP [1] ; CALL ACCPOG(1)
MOVE 2,DPY+=4251 ; IF(IGO.GT.0)RETURN
JUMPG 2,DB ; CALL DPYOUT(1)
JSA 16,DPYOUT ; END
JUMP [1]
DB: JRA 16,(16)
MVBEAM: 0 ;C THESE MOVE ENDS OF PARTIAL INNER BEAMS.
HRRZ 2,(16) ; SUBROUTINE MVBEAM(R,I,JY,L,W)
MOVE 5,@1(16) ; I
ADD 2,5 ;C L AND JY ARE FOR MOVES TO DIFF. STAFF.
ADD 2,@2(16) ; DIMENSION R(1)
MOVE 3,-1(2) ; Y=R(JY+I)
MOVM 4,3 ; Z=ABS(Y)
CAMGE 4,[=100.0] ; IF(Z.LT.100.)GO TO 1
JRST MV1
CAML 5,[6]
JRST MV1 ; IF(I.GT.5)GO TO 1
;C NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
JSA 16,AMOD ; Y=AMOD(Y,100.)
JUMP 3
JUMP [=100.0] ; 0 HAS Y
MOVE 5,@4(16) ; X=Y+W
FADR 5,0
MOVM 6,5 ; Z=Z-ABS(Y)+ABS(X)
MOVM 7,0 ;C PUTS ALL INTO POSITIVE
FSBR 4,7
FADR 4,6
SKIPGE 5 ; IF(X)Z=-Z
MOVNS 4 ; Z
JRST MV2 ; GO TO 2
MV1: FADR 3,@4(16) ;1 Z=Y+W
MOVE 4,3 ; Z NOW IN 4
MV2: HRRZI 3,@(16) ;2 R(L+I)=Z
ADD 3,@3(16)
ADD 3,@1(16)
MOVEM 4,-1(3) ; PUT IT IN R(L+I)
JRA 16,5(16) ; END
MVBX: 0 ; SUBROUTINE MVBX(I)
; COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
MOVE 2,@(16) ; EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
ADD 2,KJY+1 ; R(L+I)=R8+(R(JY+I)-R4)*RDIS
;; HRRZI 4,XRN
;; ADDI 2,(4)
;; MOVE 3,-1(2) ; R(JY+I)
MOVE 3,XRN-1(2)
FSBR 3,.COMM.+5
FMPR 3,.COMM.+=25 ; *RDIS
FADR 3,.COMM.+=9 ; +R8
MOVE 2,@(16)
ADD 2,.COMM.+=24 ; + L
;; ADDI 2,(4)
;; MOVEM 3,-1(2) ;R(L+I)
MOVEM 3,XRN-1(2)
JRA 16,1(16)
JUGGLE: 0 ; SUBROUTINE JUGGLE
; IMPLICIT INTEGER(A-Z)
; REAL PWDS,RN
; COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
; COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
SOS PTR+=250 ;ITEM=ITEM-1
HRRZI 15,XRN ; JX=RN(MEDIT)+3 WD CNT OF OLD ITEM
;C I-IX IS WD CNT OF NEW ITEM
ADD 15,DPY+=4250
MOVE 14,-1(15)
FIXX(14)
ADDI 14,3 ; JX
MOVE 13,PTR+=253 ;JY=IX
MOVE 11,PTR+=252 ; I
SUB 11,13
SUB 11,14 ;Z=I-IX-JX SPACE CHANGE
JUMPL 11,J2751 ;IF(Z)2751,172,751
JUMPE 11,J172
MOVE 5,PTR+=252 ;751 CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
SUBI 5,1
MOVE 10,DPY+=4250
ADD 10,14
JSA 16,LOOP
JUMP 5
JUMP 10
JUMP [-1]
JUMP 11
JUMP [0]
JUMP XRN
ADD 13,11 ;JY=IX+Z
JRST J172 ;GO TO 172
J2751: ADD 14,DPY+=4250 ;2751 CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
ADD 14,11
MOVE 5,11
ADD 5,PTR+=253
SOJ 5,
MOVN 10,11
JSA 16,LOOP
JUMP 14
JUMP 5
JUMP [1]
JUMP [0]
JUMP 10
JUMP XRN
;;J172: HRRZI 12,XRN ; 172 J=RN(JY)+2
;; ADDI 12,(13) ; JY
J172: MOVE 12,XRN-1(13)
;; MOVE 12,-1(12) ;RN(JY)
FIXX(12)
ADDI 12,2 ; J IS IN 12
JSA 16,LOOP ;CALL LOOP(0,J,1,MEDIT,JY,RN)
JUMP [0]
JUMP 12
JUMP [1]
JUMP DPY+=4250 ; MEDIT
JUMP 13 ; JY
JUMP XRN
MOVE 12,PTR+=253 ; I=IX+Z
ADD 12,11 ; Z IS IN 11
MOVEM 12,PTR+=252
MOVE 12,PTR+=250 ; 1751 X=ITEM+1
AOJ 12, ; X IS IN 12
HRRZI 13,DPY+=4000 ; JX=WDS(X22+1)-WDS(X22)
ADD 13,DL
MOVE 14,(13) ; WDS(X22+1) IN 14 ADR. WDS(X22) IN 13
SUB 14,-1(13) ;JX IN 14
HRRZI 10,DPY+=4000 ; J=WDS(X+1)-WDS(X)
ADDI 10,(12)
MOVE 7,(10) ;WDS(X+1)
SUB 7,-1(10) ;J IN 7
MOVEM 7,MVBX ; STORE J
SUB 7,14 ; Y=J-JX
MOVE 14,-1(10) ; JX=WDS(X)+Y+1
ADD 14,7
AOJ 14, ; JX IN 14
JUMPL 7,J2851 ; IF(Y)2851,182,282
JUMPE 7,J182
MOVE 15,(10) ;282 CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
ADDI 15,2 ; ARG 1
MOVE 6,-1(13) ; ARG 2
JSA 16,LOOP
JUMP 15
JUMP 6
JUMP [-1]
JUMP 7 ; Y
JUMP [0]
JUMP DPY
JRST J182 ; GO TO 182
J2851: MOVE 14,(13) ;2851 CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
ADD 14,7 ;+Y
ADDI 14,1 ; ARG 1
MOVE 5,-1(10) ;WDS(X)
ADD 5,7
ADDI 5,1 ; ARG 2
MOVNM 7,MVBEAM ; -Y IS STORED
JSA 16,LOOP
JUMP 14
JUMP 5
JUMP [1]
JUMP [0]
JUMP MVBEAM
JUMP DPY
MOVE 14,-1(10) ; WDS(X) JX=WDS(X)+1
ADDI 14,1 ; JX IN 14
J182: MOVE 5,-1(13) ;182 CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
ADDI 5,1 ;WDS(X22)+1
JSA 16,LOOP
JUMP [1]
JUMP MVBX
JUMP [1]
JUMP 5
JUMP 14
JUMP DPY
MOVE 2,DL ; DO 183 K=X22+1,X
;; HRRZI 5,DPY+=4000 ; 183 WDS(K)=WDS(K)+Y
;; ADD 5,2
HRRZI 3,PTR
ADDI 3,(2)
;; TLC 11,232000 ; FLOAT Z
;; FADR 11,11
J183: JUMPE 11,J184 ;IF(Z.EQ.0)GO TO 184
ADDM 11,(3) ; PWDS(K)=PWDS(K)+Z
AOJ 3, ;UPDATE PWDS AND WDS
J184: JUMPE 7,J185
ADDM 7,(13)
AOJ 13,
J185: CAIGE 2,(12)
AOJA 2,J183
;; HRRZI 2,DPY+=4000 ;ST(2)=WDS(X)
;; ADDI 2,(12) ;WDS(X+1) ADR.
;; MOVE 2,-1(2)
MOVE 2,DPY+=3999(12)
;; HRRZI 3,DPY
;; MOVEM 2,1(3)
MOVEM 2,DPY+1
SETZM DL ;X22=0
JRA 16,(16)
SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
MOVEI 2,2 ;DIMENSION RPOS(2,200)
S3: MOVE 6,2 ;(K=L HERE)
SETO 11, ;L=2
HRRZI 3,@(16) ;3 J=-1
MOVE 4,2 ;RX=RPOS(1,L-1)
SUBI 4,1 ;L-1
IMULI 4,2
ADDI 4,(3)
MOVE 5,-2(4) ;RX
S2: MOVE 7,6 ; DO 2 K=L,M
;; LSH 7,1 ;IF(RPOS(1,K).GE.RX)GO TO 2
IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
ADDI 7,(3)
CAMG 5,-2(7)
JRST S1 ; CONTINUE
MOVE 5,-2(7) ; RX=RPOS(1,K)
;;C WHY WERE ALL THE RX'S JX ????? 9/6/73
MOVE 11,6 ;J=K
S1: CAMGE 6,@1(16) ;2 CONTINUE
AOJA 6,S2
JUMPL 11,S4 ;IF(J)GO TO 4
MOVE 12,2 ;K=L-1
SOS 12
IMULI 12,2 ;(K*2)
ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
MOVE 10,-2(12)
;; LSH 11,1 ;MULTS BY 2 (LEFT SHIFT)
IMULI 11,2
ADD 11,3
EXCH 10,-2(11)
MOVEM 10,-2(12)
MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
EXCH 10,-1(11)
MOVEM 10,-1(12)
S4: CAMGE 2,@1(16) ;4 L=L+1
AOJA 2,S3 ;IF(L.LE.M)GO TO 3
JRA 16,2(16) ;END
XNOTE: 0 ;FUNCTION XNOTE(J)
MOVE 3,@(16) ;COMMON/XRN/RN(4000)
IMULI 3,12 ;DIMENSION R(10,80)
;; ADDI 3,XRN+=2993 ;EQUIVALENCE (R,RN(3001))
;; MOVE 2,(3) ;XNOTE=AMOD(R(4,J),100.)
MOVE 2,XRN+=2993(3)
JSA 16,AMOD
JUMP 2
JUMP [=100.0]
JRA 16,1(16) ;END
BAUTO: 0 ; SUBROUTINE BAUTO(J,L,K,N)
;C FOR AUTOMATIC BEAMS.
MOVEI 2,2 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
ADDB 2,@(16) ;J=J+2
MOVE 3,@3(16)
MOVE 4,@1(16)
SUB 4,3 ;L-N
MOVE 5,@2(16)
SUB 5,3 ;K-N
;; HRRZI 6,SCM
;; ADDI 6,(2)
TLC 4,232000
FADR 4,4 ;FLOATS IT
;; MOVEM 4,-2(6) ;V(J-1)=L-N
MOVEM 4,SCM-2(2)
TLC 5,232000
FADR 5,5 ;FLOATS IT
;; MOVEM 5,-1(6) ;V(J)=K-N
MOVEM 5,SCM-1(2)
JRA 16,4(16)
UPDATE: 0 ; SUBROUTINE UPDATE(I)
;; HRRZI 3,XRN ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
;; ADD 3,PTR+=252 ;RN(IS)=I
MOVE 3,PTR+=252
MOVE 2,@(16)
TLC 2,232000 ;FLOAT I
FADR 2,2
;; MOVEM 2,-1(3)
MOVEM 2,XRN-1(3)
;; MOVE 2,PTR+=252
;; ADD 2,@(16)
;; ADDI 2,3
;; MOVEM 2,PTR+=252 ;IS=IS+I+3
MOVE 2,@(16)
ADDI 2,3
ADDM 2,PTR+=252
JRA 16,1(16)
JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
IK: 0
JIT: 0 ; THESE ARE TO STORE PNTRS IN LOOP
NEWR: 0 ; SUBROUTINE NEWR
MOVE A,SC+=70 ;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
CAIE A,1 ;COMMON/XRN/RN(4000)
JRST N1 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
MOVEM JK,IK ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
MOVE JT,PTR+=250 ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
MOVEM JT,JIT ;DIMENSION R(10,80)
N1: MOVE IS,IK ;EQUIVALENCE (R,RN(3001))
MOVEM IS,PTR+=252
MOVE 14,[9999.0]
MOVE JT,JIT ;IF(MODE.NE.1)GO TO 1
ADDI JT,1 ;IK=IS
MOVEM JT,PTR+=250 ;JIT=ITEM
MOVEI K,=10 ;1 IS=IK
MOVE IZ,SCX+=41 ;ITEM=JIT+1 ******************** WAS +=33
IMULI IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
;;N2: HRRZI R,XRN+=2997 ;DO 2 K=1,IZ
;;;;N2: MOVE R,XRN+=2997(K) ;DO 2 K=1,IZ
;; ADD R,K ;IF(R(8,K).EQ.9999.)GO TO 2
;; MOVE R,(R)
;;;; CAMN R,[=9999.0]
N2: CAMN 14,XRN+=2997(K)
JRST NN2 ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
SETO IEND, ;C JUMP FOR BEAM CONT.
;; HRRZI L,XRN ;IEND=-1
;; ADD L,PTR+=252 ;RN(IS+3)=0
;; SETZM 2(L)
;; SETZM 1(L) ;RN(IS+2)=0
MOVE L,PTR+=252
SETZM XRN+2(L)
SETZM XRN+1(L)
MOVEI L,=9 ;C ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
;;N3: HRRZI R,XRN+=3000 ;DO 3 L=9,1,-1
N3: HRRZI R,XRN+=3000(K) ;DO 3 L=9,1,-1
;; ADDI R,(K) ;A=R(L,K)
ADDI R,(L)
MOVE A,-13(R) ;(OCTAL)=-11
JUMPGE IEND,NX4 ;IF(A.NE.0)GO TO 77
JUMPN A,NX3 ;IF(IEND)GO TO 3
JRST NN3
NX3: MOVE IEND,L ;77 IF(IEND)IEND=L
;;NX4: HRRZI R,XRN
;; ADD R,PTR+=252 ;RN(IS+L)=A
;; ADDI R,(L)
;; MOVEM A,-1(R)
NX4: MOVE R,PTR+=252
ADDI R,(L)
MOVEM A,XRN-1(R)
NN3: CAILE L,1 ;3 CONTINUE
SOJA L,N3
CAIGE IEND,3
MOVEI IEND,3
MOVE 15,IEND ;IF(IEND.LT.3)IEND=3
SUBI 15,2
JSA 16,UPDATE ;CALL UPDATE(IEND-2)
JUMP 15
NN2: CAML K,IZ ;2 CONTINUE
JRA 16,(16) ;END
ADDI K,=10
JRST N2
CNT: 0
MSSLUP: 0
SETZ 1, ;161 CNT=1
SETZ 2,
L5543: MOVE 3,.COMM.+4(2) ;DO 5543 K=1,9
;; ADDI 3,(2)
;; MOVE 3,(3) ;RA=RJQ(K)
SKIPE 3 ;IF(RA.NE.0)CNT=K
MOVE 1,2
;; MOVEI 4,RRJJ+1 ;5543 RJJ(K)=RA
;; ADDI 4,(2)
;; MOVEM 3,(4)
MOVEM 3,RRJJ+1(2)
CAIG 2,7 ; LOOP BACK?
AOJA 2,L5543
AOJ 1,
MOVEM 1,CNT ;REMEMBERS CNT
JRA 16,(16)
LUP2: 0
;; MOVEI 1,XRN ;261 RN(I)=CNT
;; ADD 1,PTR+=252
MOVE 2,CNT
TLC 2,232000
FADR 2,2 ;FLOATS IT
;; MOVEM 2,-1(1)
MOVE 1,PTR+=252
MOVEM 2,XRN-1(1)
MOVE 2,.COMM.+1 ;RN(I+1)=JA
TLC 2,232000
FADR 2,2
;; MOVEM 2,(1)
;; MOVE 2,PTR+=252 ;I=I+2
;; ADDI 2,2
;; MOVEM 2,PTR+=252
MOVEM 2,XRN(1)
ADDI 1,2
MOVEM 1,PTR+=252
MOVE 3,.COMM. ;RN(I)=R2
;; MOVEM 3,1(1)
MOVEM 3,XRN-1(1)
;; NOT USED NOW! IF(RD.NE.0)RN(I)=RD
;;C TO SAVE NOTE NUMBS IN P2.
SETZ 5, ;DO 4554 K=1,CNT
L4554: MOVE 2,.COMM.+4(5)
;;L4554: MOVEI 2,.COMM.+4 ;(RJQ)
;; ADDI 2,(5)
;; MOVE 2,(2)
;; MOVEI 3,XRN(5)
;; ADDI 3,(5)
;; ADD 3,PTR+=252
;; MOVEM 2,(3) ;4554 RN(I+K)=RJQ(K)
MOVE 3,1
ADDI 3,(5)
MOVEM 2,XRN(3)
AOJ 5,
CAME 5,CNT
JRST L4554
AOJ 5,
;; ADD 5,PTR+=252
ADDM 5,PTR+=252
;; MOVEM 5,PTR+=252 ;3554 I=CNT+1+I
JRA 16,(16)
RC←14 ↔ NX←15 ;**** AC'S 0,1,2,3,5 ARE USED IN 'PLACE' & 'FINDIT'!!
;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
;; SUBROUTINE HOMER
;; IMPLICIT INTEGER(A-Q,S-Z)
;; REAL PWDS,DISX,A,B,PLACE,STFF
;; COMMON /STF/RSTFAC(-3/4),RSTJ2
;; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
;; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;; COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
;; EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
;; 1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
;; 1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
HOMER: 0 ; IF(JA.EQ.6)GO TO 9
MOVE MM,.COMM.+1
CAIN MM,6
JRST H9
SKIPE .COMM.+=14 ;IF(R13.NE.0)GO TO 10
JRST H10 ; FOR GENL HOMING; WORDS; BEAMS; STEMS;
SKIPN .COMM.+=24 ;IF(JQ(1).EQ.0)GO TO 197
JRST H197 ; TO HOME IN ON NOTE ON DIFFERENT STAFF.
JSA 16,HOMNEW ; TO NEW HOMING ROUTINE FOR BEAMS 12/75
JRA 16,(16) ; TAKE OUT OLD ONE WHEN THIS IS READY
MOVE K,.COMM. ;JJ2=R2
FIXX(K)
MOVEM K,POSI+=8 ; JJ2 FOR RUNTHR
MOVE K,PTR-1(K) ;K=PWDS(JJ2) ← BEAM PTR.
MOVE XRN(K)
CAME [6.0] ; IS IT REALLY A BEAM?
JRA 16,(16) ;NO - GO BACK
;******* 19, ITEM# OF BEAM, STAFF# FOR RT. SIDE OF BEAM.
MOVE 1,XRN+5(K)
MOVE 6,[1.0]
MOVE 5,.COMM.+4 ; 2ND PARAM
CAMLE 5,[4.0] ;.GT.4 =0
SETZ 5,
SETZ L,
H401: MOVE 3,PTR(L) ; 3=KWDS(L)
CAME 5,XRN+1(3) ;IF RN(3).NE.STF, SKIP
JRST H402
CAME 6,XRN(3) ; IS IT A NOTE?
JRST H402 ; NO
MOVE XRN+2(3) ;POS OF NOTE
FSBR 1 ; NOTE POS - RT. SIDE OF BEAM
MOVM ; ABS. VALUE
CAMG [3.0] ; + OR - 3 RANGE FOR HOMING
JRST H403 ; NO CLOSE ENOUGH
H402: AOJ L, ; ADD ONE FOR LOOP
CAMGE L,PTR+=250 ; UP TO ITEM YET?
JRST H401
JRA 16,(16) ;COULDN'T HOME IN.
H403: MOVE L,PTR(L) ; PTR TO RIGHT NOTE
MOVEI JK,XRN(L) ; (RB) PTR TO NOTE
MOVE 2(JK)
MOVEM IK ;SAVE PTR TO POS OF NOTE IN IK.
;N MOVE L,.COMM.+=24
;N MOVE L,PTR-1(L) ;L=PWDS(JQ(1)) ← NOTE PTR.
MOVEI JT,XRN(K) ;RA=RN(K+3)
MOVEM JT,UPDATE ;SAVE LOC OF RN(K+1)
MOVE IS,2(JT)
MOVEM IS,JIT ;RA SAVED IN JIT
;N MOVEI JK,XRN(L) ;RB=RN(L+3)
MOVE RC,3(JK) ; RN(L+4)
MOVE NX,[1.0]
SKIPGE RC
MOVNS RC
CAMGE RC,[90.0]
JRST .+4
MOVE NX,[0.6] ; FOR MINI NOTES AND BEAMS
MOVE RC,[0.7] ;FOR MINI STEM
SKIPA
MOVE RC,[1.0]
H400: MOVEM JK,NEWR ;LOC OF RN(L+1)
;N MOVE IZ,2(JK) ; RB=POS OF NOTE, RA=POS(P3) OF BEAM
;N MOVEM IZ,IK ; RB SAVED IN IK
SETZM JUGGLE ;N=0
MOVE 0,4(JK) ;IF(RN(L+5).LT.20)N=-1
CAMGE 0,[=20.0]
SETOM JUGGLE ; -1 MEANS STEM IS UP
MOVN 0,6(JT) ;RG=-(AMOD(RN(K+7),10.)-1.)[*NX]*11./7.
MOVEM 0,XNOTE ;RN(K+7)
JSA 16,AMOD
JUMP XNOTE
JUMP [=10.0]
FADR 0,[=1.0]
FMPR 0,[=1.5714]
FMPR 0,NX
MOVEM 0,SORT2 ;RG SAVED IN SORT2
; SPACE FOR THE NUMB. OF BEAMS
MOVE L,NEWR ;J11=RN(L+2) ←STAFF # OF NOTE
MOVE JT,1(L)
FIXX(JT) ; J11 IS IN JT
SETZ MM, ;M=0
MOVE K,UPDATE ;IF(RN(K+7).LT.20.)M=-1
MOVE JK,6(K) ;RN(K+7)
CAMGE JK,[=20.0]
SETO MM,
MOVE JK,1(K) ;X=RN(K+2) ←STAFF # OF BEAM
FIXX(JK) ; X IS IN JK
; THE STAFF NUMS. X=BEAM J11=NOTE
MOVE IS,STF+3(JK) ;R3=RSTFAC(X) R3 IS IN 'IS'
FMPR IS,NX
MOVE IZ,STF+3(JT) ;R9=RSTFAC(J11)/R3
;; FDVR IZ,IS ;R9 IS IN IZ
FMPR IS,[=2.43959732] ;R8=R3*14.54/5.96
; R8=WIDTH OF NOTE
;******* 5/74 BOTH STAVES MUST BE SAME SIZE - MOST LIKELY ********
MOVE A,[=13.7142857] ;R7=96./7.
;C MUST BE DOUBLE STEM LENGTH
FMPR A,RC ; *RMINI
MOVE R,7(L) ;RD=RN(L+8) ← STEM LENGTH
; THE STEM LENGTH
CAMN R,[=999.0]
SETZM R ;IF(RD.EQ.999)RD=0
CAME MM,JUGGLE ;3 IF(M.NE.N)GO TO 5
JRST H5
SETZ IS, ;R8=0
SETZ A, ;R7=0
SETZM SORT2 ;RG=0
JRST H4 ;GO TO 4
H5: JUMPE MM,H4 ;5 IF(M.EQ.0)GO TO 4
MOVNS A ; R7=-R7
MOVNS IS ;R8=-R8
MOVNS R ;RD=-RD
MOVNS SORT2 ;RG=-RG
; NOT OK IF DIFF SIZES AND RA.GT.RB ****** 5/74
H4: FADR IS,IK ;4 RN(K+6)=RB+R8
MOVEM IS,5(K) ;SETS CORRECT HORIZONTAL PARAM OF BEAM.
MOVE MM,IZ ;RF=7.*R9
FMPR MM,[=7.0]
MOVE NN,POSI+3(JT)
FSBR NN,POSI+3(JK) ; RE=(STFF(J11)-STFF(X))/RF
;; FDVR NN,[7.0]
FDVR NN,MM
; DIST BETWEEN STAVES.
FADR A,SORT2 ;RN(K+5)=RN(L+4)+RE+(R7+RD+RG)*R9
FMPR A,IZ ; *RSTJ2 (SORT2 IS DIST BET. BEAMS)
MOVE [1.0]
FDVR IZ
FMPR NX
FADR R,
FADR A,R ; +BASIC STEM LENGTH
FADR A,NN
FADR A,3(L)
CAMG A,[90.0] ; CHECK FOR NEG. MINI POSITION
JRST .+5
CAML A,[100.0]
JRST .+5
FSBR A,[200.0] ; MAKE 90'S INTO -100'S
JRST .+3
CAMG A,[-80.0]
FADR A,[200.0]
MOVEM A,4(K)
JRA 16,(16) ;RETURN
; NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
H197: SETOM POSI+=8 ;197 JJ2=-1
MOVE R,.COMM. ;R3=R2
MOVEM R,JIT
SETZ K, ;DO 191 K=1,ITEM
H191: MOVEM K,LOOP ;SAVE K
;; MOVEI L,PTR ; L=PWDS(K)
;; ADDI L,(K)
MOVE L,PTR(K) ; L IS PWDS(K+1)
;; MOVE L,(L)
;X FIXX(L)
;; MOVEI R,XRN ;IF(RN(L+1).NE.6)GO TO 191
MOVEI R,XRN(L)
;; ADDI R,(L) ;LOC OF RN(L+1)
MOVE A,(R)
CAME A,[=6.0]
JRST HX191
MOVE J,JIT ;IF(RN(L+2).EQ.R3)GO TO 77
CAMN J,1(R)
JRST H77
CAMGE J,[=5.0] ;IF(R3.LT.5.)GO TO 191
JRST HX191 ; TYPE 19 99 FOR ALL STAVES
H77: MOVE J,-1(R) ;77
CAMN J,[=8.0] ;IF(RN(L).EQ.8)GO TO 191
JRST HX191
MOVE J,6(R) ;IF(RN(L+7).LT.10.)GO TO 191
CAMGE J,[=10.0] ;C FINDS BEAMS.
JRST HX191
FDVR J,[=10.0] ;X=RG/10.
FIXX(J) ;C STEM DIRECT.
MOVEM J,IK ;X SAVED IN IK
MOVE J,1(R) ;R2=RN(L+2)
MOVEM J,.COMM. ; USED IN 'FINDIT'
MOVE A,2(R) ;A=RN(L+3)-.01
FSBR A,[=0.01]
MOVEM A,NEWR ;SAVE A IN NEWR
MOVE J,5(R) ;B=RN(L+6)+.01
FADR J,[=0.01] ;C POS 1 AND 2
MOVEM J,BAUTO ;B SAVED IN BAUTO
FSBR J,A ;DISX=B-A
MOVEM J,UPDATE ;DISX SAVED IN UPDATE
; DISTANCE IN REAL STEPS
MOVEM R,MVBX ;SAVE LOC OF RN(L+1)
MOVE 0,3(R)
MOVEM 0,JUGGLE
JSA 16,AMOD ;RF=AMOD(RN(L+4),100.0)
JUMP JUGGLE
JUMP [=100.0]
MOVEM 0,JUGGLE ; THIS IS RF!!!!
; NOTE 2
MOVE J,MVBX
MOVE J,4(J)
MOVEM J,MSSLUP
JSA 16,AMOD ;RB=AMOD(RN(L+5),100.0)
JUMP MSSLUP
JUMP [=100.0] ;0 WILL HAVE RB!!!
FSBR 0,JUGGLE
MOVEM 0,SORT2 ;RD SAVED IN SORT2 -- RD=RB-RF
; HEIGHT
MOVEI NX,1
;;H192: MOVEM NX,DPYNEW ; DO 192 N=1,ITEM
H192: JSA 16,FINDIT ;IF(FINDIT(N))GO TO 192
;; JUMP DPYNEW
JUMP NX
JUMPL 0,HX192
MOVEI R,XRN ;IF(RN(L).EQ.8)GO TO 192
ADD R,PTR+=251 ;LOC OF RN(L+1)
MOVE J,-1(R)
CAMN J,[=8.0]
JRST HX192
MOVE J,7(R) ;IF(RN(L+8).EQ.1000.)GO TO 192
CAMN J,[=1000.0]
JRST HX192 ; SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
; FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
MOVE A,2(R) ;RC=RN(L+3)
CAMGE A,NEWR ;IF(RC.LT.A)GO TO 192
JRST HX192
CAMLE A,BAUTO ;IF(RC.GT.B)GO TO 192
JRST HX192 ; WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
MOVE J,4(R) ;IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
FDVR J,[=10.0]
FIXX(J)
CAME J,IK
JRST HX192
FSBR A,NEWR ;RC=RC-A
MOVEM A,MVBEAM ;SAVES RC
MOVEM R,MVBX ;SAVE LOC OF RN(L+1)
MOVE 0,3(R)
MOVEM 0,MSSLUP
JSA 16,AMOD ;193 RE=AMOD(RN(L+4),100.0)
JUMP MSSLUP
JUMP [=100.0]
MOVEM 0,ALF+3 ;RE SAVE HERE
MOVE J,SORT2 ;RC=RD*RC/DISX+RF
FMPR J,MVBEAM ;*RC
FDVR J,UPDATE ;/DISX
FADR J,JUGGLE ;+RF
MOVEM J,MVBEAM ;RC=
MOVE J,MVBX
MOVE J,6(J) ;RG=RN(L+7)
MOVEM J,ALF+4 ;SAVE RG
JSA 16,AMOD ;RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
JUMP ALF+4
JUMP [=10.0]
MOVEM 0,LUP2
JSA 16,AMOD
JUMP ALF+4
JUMP [=1.0]
FSBR 0,LUP2
FADR 0,ALF+4
MOVE L,MVBX
MOVEM 0,6(L) ;DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
; FRACTIONAL NOTE #
MOVE R,MVBEAM ;195 RA=RC-RE
FSBR R,ALF+3
MOVE J,IK ;IF(X.EQ.2)RA=-RA
CAIN J,2
MOVNS R
SKIPN R ;IF(RA.EQ.0)RA=999.
MOVE R,[=999.0]
MOVEM R,7(L) ;196 RN(L+8)=RA
; FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
;; MOVE NX,DPYNEW ;IF(JJ2)JJ2=N
SKIPGE POSI+=8
MOVEM NX,POSI+=8 ; SAVES # OF FIRST ITEM FOUND
HX192: CAMGE NX,PTR+=250 ;192 CONTINUE
AOJA NX,H192
HX191: MOVE K,LOOP ;191 CONTINUE
CAMGE K,PTR+=250
AOJA K,H191
JRA 16,(16) ;RETURN
H9: SKIPGE .COMM.+=32 ;9 IF(J11.LT.0)RETURN
JRA 16,(16) ; IF P11=-1 NO HOMING
MOVE R,.COMM.+=8 ; X=R7/10.
FDVR R,[=10.0]
FIXX(R)
SKIPGE R ;IF(X)X=-X
MOVNS R
MOVEM R,IK ;X SAVED IN IK
; X IS STEM DIRECTION
MOVE L,.COMM.+=10 ;RA=R9
; R9= POS3
MOVNI RC,1 ;RC=-1
SKIPE L ;IF(R9.NE.0)RC=-2
MOVNI RC,2
MOVE J,.COMM.+=31 ;IF(J10/10.EQ.3)RC=-3
IDIVI J,=10
CAIN J,3
MOVNI RC,3 ; RC=0 ESCAPES FRCOM LOOP.
;;; JRST HZ10
;;;H10: SETZ RC, ;FOR P13=1
; HOMING RANGE FOR BEAMS
;;;HZ10: MOVE IS,.COMM.+=12 ;10 IF(R11.EQ.0)R11=2.9
H10: MOVE IS,.COMM.+=12 ;10 IF(R11.EQ.0)R11=2.9
JUMPN IS,HX10
MOVE IS,[=2.9]
MOVEM IS,.COMM.+=12 ; IF P11.NE.0 RANGE IS CHANGED FROM 2
HX10: MOVE IZ,.COMM.+1 ; IF(JA.EQ.5)RC=-1
CAIN IZ,5
MOVNI RC,1
MOVEI K,1
H361: JSA 16,FINDIT ;DO 361 K=1,ITEM
JUMP K
JUMPL 0,HX361 ;IF(FINDIT(K))GO TO 361
; SKIPS NOTES ON WRONG LINE
MOVEI R,XRN ;RD=RN(L+3)
ADD R,PTR+=251 ;LOC OF RN(L+1)
MOVE A,2(R) ;RD IN A
MOVEM A,XRN+=3999 ;1 IF(JA.NE.6)GO TO 177
MOVE J,.COMM.+1
CAIE J,6
JRST H177
MOVE J,4(R) ;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
FDVR J,[=10.0]
FIXX(J)
CAME J,IK
JRST HX361
H177: JSA 16,PLACE ;177 IF(PLACE(R3))GO TO 461
JUMP .COMM.+4
JUMPL H461
MOVEM A,.COMM.+4 ;R3=RD
; LOOKS FOR NOTE, STAFF #, STEM DIR.
MOVE J,.COMM.+1 ;IF(JA.EQ.6)GO TO 861
CAIN J,6
JRST H861
CAIN J,5 ;IF(JA.EQ.5)GO TO 261
JRST H261
JRA 16,(16) ;RETURN
H461: MOVE J,.COMM.+1 ;461 IF(JA.EQ.6)GO TO 277
CAIN J,6
JRST H277
CAIE J,5 ;IF(JA.NE.5)GO TO 361
JRST HX361
H277: JSA 16,PLACE ;277 IF(PLACE(R6))GO TO 561
JUMP .COMM.+7
JUMPL H561
MOVEM A,.COMM.+7 ;R6=RD
H861: MOVE 0,.COMM.+=28 ;861 IF(J7.GE.0)GO TO 261
JUMPGE 0,H261
H561: JSA 16,PLACE ;561 IF(PLACE(RA))GO TO 661
JUMP L
JUMPL H661
MOVE 0,.COMM.+=28 ;IF(J7)GO TO 761
JUMPL H761 ; J7=NEG MEANS TREMOLO
MOVE 0,.COMM.+=9 ; IF(R8.NE.0)GO TO 761
JUMPN H761
MOVE 0,.COMM.+=11 ; IF(R10.EQ.0)GO TO 361
JUMPE HX361
H761: MOVEM A,.COMM.+=10 ;761 R9=RD
; R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.
JRST H261 ;GO TO 261
H661: CAIN J,5 ;661 IF(JA.EQ.5)GO TO 361
JRST HX361
MOVE 0,.COMM.+=31 ;IF(J10.LT.30)GO TO 361
CAIGE 0,=30
JRST HX361
JSA 16,PLACE ;IF(PLACE(R8))GO TO 361
JUMP .COMM.+=9
JUMPL HX361 ; HOMES INNER PARTIAL BEAMS
MOVEM A,.COMM.+=9 ;R8=RD
H261: SKIPN RC ;261 IF(RC.EQ.0)RETURN
JRA 16,(16)
AOJ RC ;RC=RC+1
HX361: CAMGE K,PTR+=250 ;361 CONTINUE
AOJA K,H361
JRA 16,(16) ; END
; CALL FSCAN
; GOTO RT
; GOTO LF
; GOTO UP
; GOTO DW
; GOTO 1/2
; GOTO *2
; GOTO X
; GOTO C
; ALL OTHERS(EXIT)
FSCAN: 0
INCHRW
CAIN ";"
JRA 16,(16)
CAIN ":"
JRA 16,1(16)
CAIN "("
JRA 16,2(16)
CAIN ")"
JRA 16,3(16)
CAIN "/"
JRA 16,4(16)
CAIN "*"
JRA 16,5(16)
CAIN "X"
JRA 16,6(16)
CAIN "C"
JRA 16,7(16)
JRA 16,8(16)
END